home *** CD-ROM | disk | FTP | other *** search
/ CD Exchange / CD Exchange - Volume 1.iso / utils / misc / siod / scm / pila-mutabile.scm < prev    next >
Encoding:
Text File  |  2000-01-01  |  868 b   |  33 lines
  1. (define (make-pila) (list 'pila))
  2.  
  3. (define (pila? x)
  4.         (and (pair? x) 
  5.              (eq? 'pila (car x))))
  6.  
  7. (define (empty-pila? x)
  8.         (if (pila? x) 
  9.             (null? (cdr x))
  10.             (error "arg to empty-pila must be a pila" pila)))
  11.  
  12. (define (push! x pila)
  13.         (if (pila? pila) 
  14.             (begin (set-cdr! pila
  15.                              (cons x (cdr pila)))
  16.                    pila)
  17.             (error "arg to push must be a pila" pila)))
  18.  
  19. (define (pop! pila)
  20.         (if (pila? pila) 
  21.             (if (empty-pila? pila)
  22.                 (error "pila is empty" pila)
  23.                 (begin (set-cdr! pila (cddr pila))
  24.                        pila))            
  25.             (error "arg to pop must be a pila" pila)))
  26.  
  27. (define (top pila)
  28.         (if (pila? pila) 
  29.             (cadr pila)
  30.             (error "arg to top must be a pila" pila)))
  31.  
  32.  
  33.